;;; hm--html.el:
;;; v5.82; 5 Sep 1995
;;; Copyright (C) 1993, 1994, 1995 Heiko Muenkel
;;; email: muenkel@tnt.uni-hannover.de
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;;
;;; Description:
;;;
;;; Defines functions for the file hm--html-menu.el.
;;;
;;; Installation:
;;;
;;; Put this file in one of your load path directories.
;;;
(provide 'hm--html)
(require 'hm--date)
(require 'adapt)
(defconst hm--html-menus-package-maintainer "muenkel@tnt.uni-hannover.de")
(defconst hm--html-menus-package-name "hm--html-menus")
(defconst hm--html-menus-package-version "4.14")
;;; Functions for adding html commands which consists of a start and a
;;; end tag and some text between them. (Basicfunctions)
(defun hm--html-add-tags (function-insert-start-tag
start-tag
&optional function-insert-end-tag
&optional end-tag
&optional function-insert-middle-tag
&optional middle-tag)
"Adds the start and the end html tag at point.
The first parameter specifies the funtion which insert the start tag
and the third parameter specifies the function which insert the end tag.
The second parameter is the string for the start tag and the fourth parameter
is the string for the end tag. The third and fourth parameters are optional.
The fifth parameter is optional. If it exists, it specifies a function which
inserts the sixth parameter (the middle-tag) between the start and the end
tag."
; (interactive "aFunction, which adds the HTML start tag: \n\
;aFunction, which adds the HTML end tag: \n\
;sThe HTML start tag: \n\
;sThe HTML end tag: ")
(eval (list function-insert-start-tag start-tag))
(if function-insert-middle-tag
(eval (list function-insert-middle-tag middle-tag)))
(if function-insert-end-tag
(let ((position (point)))
(eval (list function-insert-end-tag end-tag))
(goto-char position))))
(defun hm--html-add-tags-to-region (function-insert-start-tag
start-tag
function-insert-end-tag
end-tag
&optional function-insert-middle-tag
&optional middle-tag)
"Adds the start and the end html tag to the active region.
The first parameter specifies the funtion which insert the start tag
and the third parameter specifies the function which insert the end tag.
The second parameter is the string for the start tag and the fourth parameter
is the string for the end tag.
The fifth parameter is optional. If it exists, it specifies a function which
inserts the sixth parameter (the middle-tag) between the start and the end
tag."
; (interactive "aFunction, which adds the html start tag: \n\
;aFunction, which adds the html end tag: \n\
;sThe HTML start tag: \n\
;sThe HTML end tag: ")
(save-window-excursion
(let ((start (region-beginning))
(end (region-end)))
(goto-char end)
(eval (list function-insert-end-tag end-tag))
(goto-char start)
(eval (list function-insert-start-tag start-tag))
(if function-insert-middle-tag
(eval (list function-insert-middle-tag middle-tag)))
)))
(defun hm--html-insert-start-tag (tag)
"Inserts the HTML start tag 'tag' without a Newline.
The parameter must be a string (i.e. \"\")"
(let ((start (point)))
(insert tag)
(html-maybe-deemphasize-region start (- (point) 1))))
(defun hm--html-insert-end-tag (tag)
"Inserts the HTML end tag 'tag' without a Newline.
The parameter must be a string (i.e. \"\")"
(let ((start (point)))
(insert tag)
(html-maybe-deemphasize-region start (- (point) 1))))
(defun hm--html-insert-start-tag-with-newline (tag)
"Inserts the HTML start tag 'tag' with a Newline.
The parameter must be a string (i.e. \"
\")"
(let ((start (point)))
(insert tag)
(html-maybe-deemphasize-region start (- (point) 1)))
(insert "\n"))
(defun hm--html-insert-end-tag-with-newline (tag)
"Inserts the HTML end tag 'tag' with a Newline.
The parameter must be a string (i.e. \"
\")"
(insert "\n")
(let ((start (point)))
(insert tag)
(html-maybe-deemphasize-region start (- (point) 1))))
;;; Functions which add simple tags of the form
(defun hm--html-add-line-break ()
"Adds the HTML tag for a line break."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag " "))
(defun hm--html-add-horizontal-rule ()
"Adds the HTML tag for a horizontal rule (line)."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag ""))
(defun hm--html-add-paragraph ()
"Adds the HTML tags for a paragraph at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline
"
"
'hm--html-insert-end-tag-with-newline
"
"))
(defun hm--html-add-paragraph-to-region ()
"Adds the HTML tags for a paragraph to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
"
"
'hm--html-insert-end-tag-with-newline
"
"))
(defun hm--html-add-paragraph-separator ()
"Adds the tag for a paragraph seperator."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag "
"))
;;; Functions which include something in HTML- documents
(defvar hm--html-url-history-list nil
"History list for the function 'hm--html-read-url'")
(defun hm--html-read-url-predicate (table-element-list usagesymbol)
"Predicatefunction for hm--html-read-url."
(hm--html-read-url-predicate-1 (cdr table-element-list) usagesymbol))
(defun hm--html-read-url-predicate-1 (table-element-list usagesymbol)
"Internal function of hm--html-read-url-predicate."
(cond ((not table-element-list) nil)
((eq (car table-element-list) usagesymbol))
(t (hm--html-read-url-predicate-1 (cdr table-element-list)
usagesymbol))))
(defun hm--html-read-url (prompt &optional
table
predicate
require-match
initial-contents)
"Function prompts for a URL string.
TABLE is an alist whose elements' cars are URL's.
PREDICATE limits completion to a subset of TABLE.
If REQUIRE-MATCH is non-nil, the user is not allowed to exit unless
the input is (or completes to) an element of TABLE.
INITIAL-CONTENTS is a string to insert in the minibuffer before reading.
If INITIAL-CONTENTS is nil, the car of the 'hm--html-url-history-list'
is used instead."
(if table
(completing-read prompt
table
predicate
require-match
initial-contents
hm--html-url-history-list)
(read-string prompt
(if initial-contents
initial-contents
(car hm--html-url-history-list))
hm--html-url-history-list)))
(defun hm--html-read-altenate (url)
"Function reads the value for the \"ALT\"- attribute in IMG tags.
URL will be used as the default URL for the external viewer."
(let ((alttype
(string-to-int
(completing-read
; "0: No ALT atribute, 1: ALT=\"\", 2: ALT=Text, 3: ALT=External Viewer: "
"0: No ALT atribute, 1: ALT=\"\", 2: ALT=Text: "
; '(("0") ("1") ("2") ("3"))
'(("0") ("1") ("2"))
nil
t
"2"))))
(cond ((= alttype 0) nil)
((= alttype 1) "")
((= alttype 2) (read-string
"Text for the ALT attribute: "
(substring (file-name-nondirectory url)
0
(string-match
"\\."
(file-name-nondirectory url)))))
; ((= alttype 3) (concat ""
; (file-name-nondirectory url)
; ""))
)))
(defun hm--html-add-image-bottom (href alt)
"Add an image, bottom aligned."
(interactive (let ((url (hm--html-read-url "Image URL: ")))
(list url (hm--html-read-altenate url))))
(let ((start (point)))
(if alt
(insert "")
(insert ""))
(html-maybe-deemphasize-region (1+ start) (1- (point)))))
(defun hm--html-add-image-middle (href alt)
"Add an image, middle aligned."
(interactive (let ((url (hm--html-read-url "Image URL: ")))
(list url (hm--html-read-altenate url))))
(let ((start (point)))
(if alt
(insert "")
(insert ""))
(html-maybe-deemphasize-region (1+ start) (1- (point)))))
(defun hm--html-add-image-top (href alt)
"Add an image, top aligned."
(interactive (let ((url (hm--html-read-url "Image URL: ")))
(list url (hm--html-read-altenate url))))
(let ((start (point)))
(if alt
(insert "")
(insert ""))
(html-maybe-deemphasize-region (1+ start) (1- (point)))))
(defun hm--html-add-server-side-include-file (file)
"This function adds a server side include file directive in the buffer.
The directive is only supported by the NCSA http daemon."
(interactive "FInclude File: ")
(let ((start (point)))
(if (string= file "")
(error "ERROR: No filename specified !")
(insert "")
(html-maybe-deemphasize-region (1+ start) (1- (point))))))
(defun hm--html-add-server-side-include-command-with-isindex-parameter
(command)
"This function adds a server side include command directive in the buffer.
The include command uses the \"isindex\"- parameter for the specified command."
(interactive (list
(completing-read "Include Command: "
hm--html-server-side-include-command-alist)))
(hm--html-add-server-side-include-command command t))
(defun hm--html-add-server-side-include-command (command &optional srvurl)
"This function adds a server side include command directive in the buffer.
The directive is only supported by the NCSA http daemon.
If SRVURL is t, then the attribute srvurl instead of srv is used for the
include command. With srvurl, the include command uses the \"isindex\"-
parameter for the specified command."
(interactive (list
(completing-read "Include Command: "
hm--html-server-side-include-command-alist)))
(let ((start (point))
(attribute (if srvurl "SRVURL" "SRV")))
(if (string= command "")
(error "ERROR: No command specified !")
(if (= ?| (string-to-char command))
(insert "")
(insert "")
(html-maybe-deemphasize-region (1+ start) (1- (point)))))))
;(defun hm--html-add-server-side-include-command-with-parameter (command
; parameter)
; "This function adds a server side include command directive in the buffer.
;The directive is only supported by the NCSA http daemon."
; (interactive (list
; (completing-read
; "Include Command: "
; hm--html-server-side-include-command-with-parameter-alist)
; (read-string "Parameterlist sepearted by '?': ")))
; (let ((start (point)))
; (if (string= command "")
; (error "ERROR: No command specified !")
; (if (string= parameter "")
; (error "ERROR: No parameter specified !")
; (if (= ?| (string-to-char command))
; (if (= ?? (string-to-char parameter))
; (insert "")
; (insert ""))
; (if (= ?? (string-to-char parameter))
; (insert "")
; (insert "")))
; (html-maybe-deemphasize-region (1+ start) (1- (point)))))))
;;; Functions, which adds tags of the form ...
(defun hm--html-add-bold ()
"Adds the HTML tags for Bold at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-bold-to-region ()
"Adds the HTML tags for Bold to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-italic ()
"Adds the HTML tags for Italic at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-italic-to-region ()
"Adds the HTML tags for Italic to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-underline ()
"Adds the HTML tags for Underline at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-underline-to-region ()
"Adds the HTML tags for Underline to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-definition ()
"Adds the HTML tags for Definition at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-definition-to-region ()
"Adds the HTML tags for Definition to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-code ()
"Adds the HTML tags for Code at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-code-to-region ()
"Adds the HTML tags for Code to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-citation-to-region ()
"Adds the HTML tags for Citation to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-emphasized-to-region ()
"Adds the HTML tags for Emphasized to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-fixed-to-region ()
"Adds the HTML tags for Fixed to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-keyboard-to-region ()
"Adds the HTML tags for Keyboard to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-sample-to-region ()
"Adds the HTML tags for Sample to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-strong-to-region ()
"Adds the HTML tags for Strong to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-variable-to-region ()
"Adds the HTML tags for Variable to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-comment ()
"Adds the HTML tags for Comment at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""))
(defun hm--html-add-comment-to-region ()
"Adds the HTML tags for Comment to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""))
(defun hm--html-add-preformated ()
"Adds the HTML tags for preformated text at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline
"
"
'hm--html-insert-end-tag-with-newline
"
"))
(defun hm--html-add-preformated-to-region ()
"Adds the HTML tags for preformated text to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
"
"
'hm--html-insert-end-tag-with-newline
"
"))
(defun hm--html-add-plaintext-to-region ()
"Adds the HTML tags for plaintext to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
""))
(defun hm--html-add-blockquote-to-region ()
"Adds the HTML tags for blockquote to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
"
"
'hm--html-insert-end-tag-with-newline
"
"))
(defun hm--html-add-abstract ()
"Adds the HTML tags for abstract text at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
""))
(defun hm--html-add-abstract-to-region ()
"Adds the HTML tags for abstract text to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
""))
(defun hm--html-add-strikethru ()
"Adds the HTML tags for Strikethru at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-strikethru-to-region ()
"Adds the HTML tags for Strikethru to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-superscript ()
"Adds the HTML tags for Superscript at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-superscript-to-region ()
"Adds the HTML tags for Superscript to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-subscript ()
"Adds the HTML tags for Subscript at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-subscript-to-region ()
"Adds the HTML tags for Subscript to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-quote ()
"Adds the HTML tags for Quote at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-quote-to-region ()
"Adds the HTML tags for Quote to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-person ()
"Adds the HTML tags for Person at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-person-to-region ()
"Adds the HTML tags for Person to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-instance ()
"Adds the HTML tags for Instance at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-instance-to-region ()
"Adds the HTML tags for Instance to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-option ()
"Adds the HTML tags for Option at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-option-to-region ()
"Adds the HTML tags for Option to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-publication ()
"Adds the HTML tags for Publication at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-publication-to-region ()
"Adds the HTML tags for Publication to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-author ()
"Adds the HTML tags for Author at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-author-to-region ()
"Adds the HTML tags for Author to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-editor ()
"Adds the HTML tags for Editor at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-editor-to-region ()
"Adds the HTML tags for Editor to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-credits ()
"Adds the HTML tags for Credits at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-credits-to-region ()
"Adds the HTML tags for Credits to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-copyright ()
"Adds the HTML tags for Copyright at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-copyright-to-region ()
"Adds the HTML tags for Copyright to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-isbn ()
"Adds the HTML tags for ISBN at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-isbn-to-region ()
"Adds the HTML tags for ISBN to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-acronym ()
"Adds the HTML tags for Acronym at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-acronym-to-region ()
"Adds the HTML tags for Acronym to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-abbrevation ()
"Adds the HTML tags for Abbrevation at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-abbrev-to-region ()
"Adds the HTML tags for Abbrev to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-command ()
"Adds the HTML tags for Command at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-command-to-region ()
"Adds the HTML tags for Command to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-argument ()
"Adds the HTML tags for Argument at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-argument-to-region ()
"Adds the HTML tags for Argument to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-literature ()
"Adds the HTML tags for Literature at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-literature-to-region ()
"Adds the HTML tags for Literature to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-footnote ()
"Adds the HTML tags for Footnote at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-footnote-to-region ()
"Adds the HTML tags for Footnote to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-margin ()
"Adds the HTML tags for Margin at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
(defun hm--html-add-margin-to-region ()
"Adds the HTML tags for Margin to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
""
'hm--html-insert-end-tag
""))
;;; Lists
(defun hm--html-add-listing-to-region ()
"Adds the HTML tags for listing to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
""))
(defun hm--html-add-numberlist ()
"Adds the HTML tags for a numbered list at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
""
'hm--html-insert-start-tag
"
"))
(defun hm--html-add-numberlist-to-region ()
"Adds the HTML tags for a numbered list to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
""
'hm--html-insert-start-tag
"
"))
(defun hm--html-add-directory-list ()
"Adds the HTML tags for a directory list at the point in the current buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
""
'hm--html-insert-start-tag
"
"))
(defun hm--html-add-directorylist-to-region ()
"Adds the HTML tags for a directory list to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
""
'hm--html-insert-start-tag
"
"))
(defun hm--html-add-list-to-region ()
"Adds the HTML tags for a (unnumbered) list to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
"
"
'hm--html-insert-end-tag-with-newline
"
"
'hm--html-insert-start-tag
"
"))
(defun hm--html-add-menu-to-region ()
"Adds the HTML tags for a menu to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-start-tag
"
"))
(defun hm--html-add-description-list-to-region ()
"Adds the HTML tags for a description list to a region.
It also inserts a tag for the description title."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
"
"
'hm--html-insert-end-tag-with-newline
"
"
'hm--html-insert-start-tag
"
"))
(defun hm--html-add-description-title ()
"Adds the HTML tag for a description title at current point in the buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-end-tag-with-newline
"
"))
(defun hm--html-add-only-description-entry ()
"Adds the HTML tag for a description entry at current point in the buffer."
(interactive)
(hm--html-add-tags 'hm--html-insert-end-tag-with-newline
"
"))
(defun hm--html-add-address-to-region ()
"Adds the HTML tags for an address to the region"
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
" "
'hm--html-insert-end-tag
" "))
(defvar hm--html-signature-reference-name "Signature"
"The signature reference name.")
(defun hm--html-make-signature-link-string (signature-file-name)
"Returns a string which is a link to a signature file."
(concat
""))
(defun hm--html-delete-old-signature ()
"Searches for the old signature and deletes it, if the user want it"
(save-excursion
(goto-char (point-min))
(if (search-forward (concat " "
"" nil t)
(point))))
(if (yes-or-no-p "Delete the old signature (yes or no) ?")
(delete-region signature-start signature-end))))))
(defun hm--html-set-point-for-signature ()
"Searches and sets the point for inserting the signature.
It searches from the end to the beginning of the file. At first it
tries to use the point before the tag then the point before
the tag and the the end of the file."
(goto-char (point-max))
(cond ((search-backward "" nil t)
(end-of-line 0)
(if (> (current-column) 0)
(newline 2)))
((search-backward "" nil t)
(end-of-line 0)
(if (> (current-column) 0)
(newline 2)))
((> (current-column) 0)
(newline 2))
(t)))
(defun hm--html-add-signature ()
"Adds the owner's signature at the end of the buffer."
(interactive)
(if hm--html-signature-file
(progn
(if (not hm--html-username)
(setq hm--html-username (user-full-name)))
(save-excursion
(hm--html-delete-old-signature)
(hm--html-set-point-for-signature)
(hm--html-add-tags 'hm--html-insert-start-tag
" "
'hm--html-insert-end-tag
""
'hm--html-insert-start-tag
(hm--html-make-signature-link-string
hm--html-signature-file)
)
(insert hm--html-username)))
(error "ERROR: Define your hm--html-signature-file first !")))
(defun hm--html-add-header (size &optional header)
"Adds the HTML tags for a header at the point in the current buffer."
(interactive "nSize (1 .. 6; 1 biggest): ")
(if (or (< size 1) (> size 6))
(message "The size must be a number from 1 to 6 !")
(hm--html-add-tags 'hm--html-insert-start-tag
(format "" size)
'hm--html-insert-start-tag-with-newline
(format "" size))
(if header
(insert header))))
(defun hm--html-add-header-to-region (size)
"Adds the HTML tags for a header to the region.
The parameter 'size' specifies the size of the header."
(interactive "nSize (1 .. 6; 1 biggest): ")
(if (or (< size 1) (> size 6))
(message "The size must be a number from 1 to 6 !")
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
(format "" size)
'hm--html-insert-end-tag
(format "" size))))
(defun hm--html-set-point-for-title ()
"Searches and sets the point for inserting the HTML element title.
The functions start at the beginning of the file and searches first
for the HTML tag . If such a tag exists, the point is set to the
position after the tag. If not, the function next searches for the
tag and sets the point after the tag, if it exists, or searches for
the tag . If this tag exists, the point is set to the position after
this tag or the beginning of the file otherwise."
(goto-char (point-min))
(cond ((search-forward-regexp "" nil t) (newline))
((search-forward-regexp "" nil t) (newline))
((search-forward-regexp "" nil t) (newline))
(t)))
(defun hm--html-add-title (title)
"Adds the HTML tags for a title at the beginning of the buffer."
(interactive "sTitle: ")
(save-excursion
(goto-char (point-min))
(if (search-forward "" nil t)
(let ((point-after-start-tag (point)))
(if (not (search-forward "" nil t))
nil
(goto-char (- (point) 8))
(delete-backward-char (- (point) point-after-start-tag))
(let ((start (point)))
(insert title " (" (hm--date) ")")
(goto-char start))))
;; Noch kein im Buffer vorhanden
(hm--html-set-point-for-title)
(hm--html-add-tags 'hm--html-insert-start-tag
"<TITLE>"
'hm--html-insert-end-tag
""
'insert
(concat title " (" (hm--date) ")"))
(forward-char 8)
(newline 1)
)))
(defun hm--html-add-title-to-region ()
"Adds the HTML tags for a title to the region."
(interactive)
(let ((title (buffer-substring (region-beginning) (region-end))))
(save-excursion
(goto-char (point-min))
(if (search-forward "" nil t)
(let ((point-after-start-tag (point)))
(if (not (search-forward "" nil t))
nil
(goto-char (- (point) 8))
(delete-backward-char (- (point) point-after-start-tag))
(insert title " (" (hm--date) ")")))
;; Noch kein im Buffer vorhanden
(hm--html-set-point-for-title)
(hm--html-add-tags 'hm--html-insert-start-tag
"<TITLE>"
'hm--html-insert-end-tag
""
'insert
(concat title " (" (hm--date) ")"))
(forward-char 8)
;(newline 1)
))))
(defun hm--html-add-html ()
"Adds the HTML tags and in the buffer.
The tag will be inserted at the beginning and at the
end of the file."
(interactive)
(let ((new-cursor-position nil))
(save-excursion
(goto-char (point-min))
(if (search-forward "" nil t)
(error "There is an old tag in the current buffer !")
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline "")
; (newline 1)
)
(setq new-cursor-position (point))
(goto-char (point-max))
(if (search-backward "" nil t)
(error "There is an old tag in the current buffer !")
(newline 1)
(hm--html-add-tags 'hm--html-insert-end-tag "")))
(goto-char new-cursor-position)))
(defun hm--html-add-head ()
"Adds the HTML tags and in the buffer.
The tags will be inserted after or at the beginning of the file.
The function also looks for the tags and ."
(interactive)
(goto-char (point-min))
(if (search-forward "" nil t)
(if (search-forward "" nil t)
(error "There is an old tag in the current buffer !")
(if (search-forward "" nil t)
(error "There is an old tag in the current buffer !")
(newline 1))))
(let ((start-tag-position (point)))
(if (search-forward "" nil t)
(progn
(forward-line 0)
(forward-char -1)
(if (= (point) (point-min))
(progn
(newline)
(forward-line -1)))
(hm--html-add-tags 'hm--html-insert-end-tag-with-newline
"")
(goto-char start-tag-position)
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline
"")
)
(if (search-forward "" nil t)
(progn
(newline 1)
(hm--html-add-tags 'hm--html-insert-end-tag-with-newline
"")
(goto-char start-tag-position)
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline
""))
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
"")))))
(defun hm--html-add-head-to-region ()
"Adds the HTML tags and to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
""))
(defun hm--html-add-body ()
"Adds the HTML tags and in the buffer.
The tags will be inserted before or at the end of the file."
(interactive)
(goto-char (point-max))
(if (search-backward "" nil t)
(progn
(if (search-backward "" nil t)
(error "There is an old tag in the current buffer !")
(if (search-backward "" nil t)
(error "There is an old tag in the current buffer !")))
(forward-char -1)))
(let ((end-tag-position (point)))
(if (search-backward "" nil t)
(progn
(forward-char 7)
(newline 1)
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline
"")
(let ((cursor-position (point)))
(goto-char (+ end-tag-position 8))
(hm--html-add-tags 'hm--html-insert-end-tag-with-newline
"")
(goto-char cursor-position)
))
(if (not (= (current-column) 0))
(newline))
(hm--html-add-tags 'hm--html-insert-start-tag-with-newline ""
'hm--html-insert-end-tag-with-newline ""))))
(defun hm--html-add-body-to-region ()
"Adds the HTML tags and to the region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag-with-newline
""
'hm--html-insert-end-tag-with-newline
""))
(defun hm--html-add-title-and-header (title)
"Adds the HTML tags for a title and a header in the current buffer."
; (interactive "sTitle and Header String: \nnHeader Size (1 .. 6): ")
; (if (> size 6)
; (message "The size must be a number from 1 to 6 !")
(interactive "sTitle and Header String: ")
(hm--html-add-title title)
(save-excursion
(goto-char (point-min))
(search-forward "" nil t)
(if (search-forward "" nil t)
(progn
(search-forward "" nil t)
(newline 1))
(if (search-forward "" nil t)
(newline 1)
(if (string= (what-line) "Line 1")
(progn
(end-of-line)
(newline 1)))))
(hm--html-add-header 1 title)))
(defun hm--html-add-title-and-header-to-region ()
"Adds the HTML tags for a title and a header to the region."
;The parameter 'size' spezifies the size of the header.";"
; (interactive "nSize (1 .. 6): ")
; (if (> size 6)
; (message "The size must be a number from 1 to 6 !")
(interactive)
(let ((title (buffer-substring (region-beginning) (region-end))))
(hm--html-add-header-to-region 1)
(hm--html-add-title title)))
(defun hm--html-add-full-html-frame (title)
"Adds a full HTML frame to the current buffer.
The frame consists of the elements html, head, body, title,
header and the signature. The parameter TITLE specifies the
title and the header of the document."
(interactive "sTitle and Header String: ")
(hm--html-add-html)
(hm--html-add-head)
(hm--html-add-body)
(hm--html-add-title-and-header title)
(if hm--html-signature-file
(hm--html-add-signature))
(goto-char (point-min))
(search-forward "" nil t)
(forward-line 1)
(if hm--html-automatic-created-comment
(hm--html-insert-created-comment)))
(defun hm--html-add-full-html-frame-with-region ()
"Adds a full HTML frame to the current buffer with the use of a region.
The frame consists of the elements html, head, body, title,
header and the signature. The function uses the region as
the string for the title and the header of the document."
(interactive)
(hm--html-add-title-and-header-to-region)
(hm--html-add-html)
(hm--html-add-head)
(hm--html-add-body)
(hm--html-add-signature)
(if hm--html-automatic-created-comment
(hm--html-insert-created-comment)))
(defun hm--html-add-link-target (name)
"Adds the HTML tags for a link target at point in the current buffer."
; (interactive "sName (or RET for numeric): ")
(interactive "sName: ")
; (and (string= name "")
; (progn
; (setq html-link-counter (1+ html-link-counter))
; (setq name (format "%d" html-link-counter))))
(hm--html-add-tags 'hm--html-insert-start-tag
(concat "")
'hm--html-insert-end-tag
""))
;;; Functions which add links
(defun hm--html-mark-example (parameter-list)
"Marks the example of the parameterlist in the current buffer.
It returns the example extent."
(if (hm--html-get-example-from-parameter-list parameter-list)
(progn
(search-forward (hm--html-get-example-from-parameter-list
parameter-list))
(let ((extent (make-extent (match-beginning 0)
(match-end 0))))
(set-extent-face extent 'hm--html-help-face)
extent))))
(defun hm--html-unmark-example (extent)
"Unmarks the example for the current question."
(if extent
(delete-extent extent)))
; )
; ;; For the Emacs 19
; (defun hm--html-mark-example (parameter-list)
; "Marks the example of the parameterlist in the current buffer.
;It returns the example extent."
; (if (hm--html-get-example-from-parameter-list parameter-list)
; (progn
; (search-forward (hm--html-get-example-from-parameter-list
; parameter-list))
; (put-text-property (match-beginning 0)
; (match-end 0)
; 'face
; 'hm--html-help-face))))
;
;
; (defun hm--html-unmark-example (extent)
; "Unmarks the example for the current question."
; t))
(defun hm--html-write-alist-in-buffer (alist)
"The function writes the contents of the ALIST in the currentbuffer."
(cond ((car alist)
(insert (int-to-string (car (car alist))) ":\t" (cdr (car alist)))
(newline)
(hm--html-write-alist-in-buffer (cdr alist)))))
(defun hm--html-select-directory (alist default)
"The function selects one of the directories of the ALIST,
or the DEFAULT or the 'default-directory' by number. See also the
documentation of the function hm--html-read-filename."
(if (or (string= default "") (not default))
(setq default default-directory))
(if alist
(save-window-excursion
(let ((buffername (generate-new-buffer "*html-directories*")))
(set-buffer buffername)
(insert "Select one of the following directories by number !")
(newline)
(insert "===================================================")
(newline)
(insert "0:\t" default)
(newline)
(hm--html-write-alist-in-buffer alist)
(goto-char (point-min))
(pop-to-buffer buffername))
(let ((dirnumber (read-number
"Select directory prefix by number: "
t)))
(kill-buffer "*html-directories*")
(expand-file-name (or (cdr (assoc dirnumber alist)) default))))
(expand-file-name default))
)
(defun hm--html-delete-wrong-path-prefix-1 (filename prefix-list)
"The function deletes wrong path prefixes."
(cond (prefix-list (if (string-match (car prefix-list) filename)
(substring filename (match-end 0))
(hm--html-delete-wrong-path-prefix-1 filename
(cdr prefix-list)
)))
(t filename)))
(defun hm--html-delete-wrong-path-prefix (filename)
"The function deletes wrong path prefixes.
The path prefixes are specified by the variable
`hm--html-delete-wrong-path-prefix'."
(if (not hm--html-delete-wrong-path-prefix)
filename
(if (listp hm--html-delete-wrong-path-prefix)
(hm--html-delete-wrong-path-prefix-1 filename
hm--html-delete-wrong-path-prefix)
(hm--html-delete-wrong-path-prefix-1 filename
(list
hm--html-delete-wrong-path-prefix))
)))
(defun hm--html-read-filename (parameter-list)
"The function reads a filename with its directory path,
if PARAMETER-LIST is not nil. If the PARAMETER-LIST is nil, only an empty
string will be returned.
The PARAMETER-LIST consists of the following elements:
PROMPT, ALIST, DEFAULT, REQUIRE-MATCH, EXAMPLE.
If the ALIST is nil and DEFAULT is nil, then the function only reads
a filename (without path). These precede the following.
If the ALIST isn't nil, the function lists the contents of the ALIST
in a buffer and reads a number from the minbuffer, which selects one
of the directories (lines) of the buffer. Therefore the ALIST must look
like the following alist:
((1 . \"/appl/gnu/\") (2 . \"/\"))
If only ALIST is nil, or if you type a number which is not in the ALIST,
the DEFAULT directory is selected. If the DEFAULT is nil or \"\" the
'default-directory' is selected.
After that the function reads the name of the file from the minibuffer.
Therefore the PROMPT is printed in the minibuffer and the selected directory
is taken as the start of the path of the file.
If REQUIRE-MATCH is t, the filename with path must match an existing file."
(if parameter-list
(let ((marked-object (hm--html-mark-example parameter-list))
(prompt (hm--html-get-prompt-from-parameter-list parameter-list))
(alist (hm--html-get-alist-from-parameter-list parameter-list))
(default (hm--html-get-default-from-parameter-list parameter-list))
(require-match (hm--html-get-require-match-from-parameter-list
parameter-list))
(filename nil))
(if (or alist default)
(let ((directory (hm--html-select-directory alist default)))
(setq filename (read-file-name prompt
directory
directory
require-match
nil)))
(setq filename (read-file-name prompt
""
""
require-match
nil)))
(hm--html-unmark-example marked-object)
(hm--html-delete-wrong-path-prefix filename))
; (if (not hm--html-delete-wrong-path-prefix)
; filename
; (if (string-match hm--html-delete-wrong-path-prefix filename)
; (substring filename (match-end 0))
; filename)))
""))
(defun hm--html-completing-read (parameter-list)
"Reads a string with completing-read, if alist is non nil.
The PARAMETER-LIST consists of the following elements:
PROMPT, ALIST, DEFAULT, REQUIRE-MATCH, EXAMPLE.
If ALIST is nil, it returns the DEFAULT, or if the DEFAULT is
also nil it returns an empty string."
(let ((marked-object (hm--html-mark-example parameter-list))
(string
(if (hm--html-get-alist-from-parameter-list parameter-list)
(completing-read
(hm--html-get-prompt-from-parameter-list parameter-list)
(hm--html-get-alist-from-parameter-list parameter-list)
nil
(hm--html-get-require-match-from-parameter-list
parameter-list)
(hm--html-get-default-from-parameter-list
parameter-list))
(if (hm--html-get-default-from-parameter-list parameter-list)
(hm--html-get-default-from-parameter-list parameter-list)
""))))
(hm--html-unmark-example marked-object)
string))
(defvar hm--html-faces-exist nil)
(defun hm--html-generate-help-buffer-faces ()
"Generates faces for the add-link-help-buffer."
(if (not (facep 'hm--html-help-face))
; (if (not hm--html-faces-exist)
(progn
(setq hm--html-faces-exist t)
(make-face 'hm--html-help-face)
(set-face-foreground 'hm--html-help-face hm--html-help-foreground)
(set-face-background 'hm--html-help-face hm--html-help-background)
(set-face-font 'hm--html-help-face hm--html-help-font)
)))
(defun hm--html-get-prompt-from-parameter-list (parameter-list)
"Returns the prompt from the PARAMETER-LIST."
(car parameter-list))
(defun hm--html-get-alist-from-parameter-list (parameter-list)
"Returns the alist from the PARAMETER-LIST."
(car (cdr parameter-list)))
(defun hm--html-get-default-from-parameter-list (parameter-list)
"Returns the default from the PARAMETER-LIST."
(car (cdr (cdr parameter-list))))
(defun hm--html-get-require-match-from-parameter-list (parameter-list)
"Returns the require-match from the PARAMETER-LIST."
(car (cdr (cdr (cdr parameter-list)))))
(defun hm--html-get-example-from-parameter-list (parameter-list)
"Returns the example from the PARAMETER-LIST."
(car (cdr (cdr (cdr (cdr parameter-list))))))
(defun hm--html-get-anchor-seperator-from-parameter-list (parameter-list)
"Returns the anchor-seperator from the PARAMETER-LIST."
(car (cdr (cdr (cdr (cdr (cdr parameter-list)))))))
(defun hm--html-generate-add-link-help-buffer (scheme-parameter-list
host-name:port-parameter-list
servername:port-parameter-list
path+file-parameter-list
anchor-parameter-list)
"Generates and displays a help buffer with an example for adding a link."
(let ((buffername (generate-new-buffer "*Link-Example*")))
(pop-to-buffer buffername)
(shrink-window (- (window-height) 5))
(insert "Example:")
(newline 2)
(if (hm--html-get-example-from-parameter-list scheme-parameter-list)
(progn
(insert (hm--html-get-example-from-parameter-list
scheme-parameter-list))
(if (hm--html-get-example-from-parameter-list
scheme-parameter-list)
(progn
(insert ":")
(if (hm--html-get-example-from-parameter-list
host-name:port-parameter-list)
(insert "//"))))))
(if (hm--html-get-example-from-parameter-list
host-name:port-parameter-list)
(progn
(insert (hm--html-get-example-from-parameter-list
host-name:port-parameter-list))
(if (and (hm--html-get-example-from-parameter-list
servername:port-parameter-list)
(not (string= "/"
(substring
(hm--html-get-example-from-parameter-list
servername:port-parameter-list)
0
1))))
(insert "/"))))
(if (hm--html-get-example-from-parameter-list
servername:port-parameter-list)
(progn
(insert (hm--html-get-example-from-parameter-list
servername:port-parameter-list))
(if (hm--html-get-example-from-parameter-list
path+file-parameter-list)
(insert "/"))))
(if (hm--html-get-example-from-parameter-list path+file-parameter-list)
(progn
(insert (hm--html-get-example-from-parameter-list
path+file-parameter-list))))
(if (hm--html-get-example-from-parameter-list anchor-parameter-list)
(progn
(insert (hm--html-get-anchor-seperator-from-parameter-list
anchor-parameter-list))
(insert (hm--html-get-example-from-parameter-list
anchor-parameter-list))))
(goto-char (point-min))
buffername
))
(defun hm--html-add-link (function-add-tags
scheme-parameter-list
host-name:port-parameter-list
servername:port-parameter-list
path+file-parameter-list
anchor-parameter-list)
"The function adds a link in the current buffer.
The parameter FUNCTION-ADD-TAGS determines the function which adds the tag
in the buffer (for example: 'hm--html-add-tags or
'hm--html-add-tags-to-region).
The parameters SCHEME-PARAMETER-LIST, HOST-NAME:PORT-PARAMETER-LIST,
SERVERNAME:PORT-PARAMETER-LIST, PATH+FILE-PARAMETER-LIST and
ANCHOR-PARAMETER-LIST are lists with a prompt string, an alist, a default
value and an example string. The ANCHOR-PARAMETER-LIST has as an additional
element an anchor seperator string. All these elements are used to read and
construct the link."
(let ((point nil))
(save-window-excursion
(let ((html-buffer (current-buffer))
(html-help-buffer (hm--html-generate-add-link-help-buffer
scheme-parameter-list
host-name:port-parameter-list
servername:port-parameter-list
path+file-parameter-list
anchor-parameter-list))
(scheme (hm--html-completing-read scheme-parameter-list))
(hostname:port (hm--html-completing-read
host-name:port-parameter-list))
(servername:port (hm--html-completing-read
servername:port-parameter-list))
(path+file (hm--html-read-filename path+file-parameter-list))
(anchor (hm--html-completing-read anchor-parameter-list))
; (hrefname (setq html-link-counter (1+ html-link-counter)))
(anchor-seperator
(hm--html-get-anchor-seperator-from-parameter-list
anchor-parameter-list)))
(if (not (string= scheme ""))
(if (string= hostname:port "")
(setq scheme (concat scheme ":"))
(setq scheme (concat scheme "://"))))
(if (and (not (string= hostname:port ""))
(not (string= servername:port ""))
(not (string= (substring servername:port 0 1) "/")))
(setq servername:port (concat "/" servername:port)))
(if (and (not (string= path+file ""))
(not (string= "/" (substring path+file 0 1))))
(setq path+file (concat "/" path+file)))
(if (not (string= anchor ""))
(setq anchor (concat anchor-seperator anchor)))
(kill-buffer html-help-buffer)
(pop-to-buffer html-buffer)
(eval (list function-add-tags
''hm--html-insert-start-tag
(concat "")
''hm--html-insert-end-tag
"")))
(setq point (point))))
(goto-char (point)))
(defun hm--html-add-info-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a link on a GNU Info file."
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
"http"
t
"http")
(list ; hostname:port
"Gateway and Port: "
hm--html-info-hostname:port-alist
hm--html-info-hostname:port-default
nil
"www.tnt.uni-hannover.de:8005")
(list ; servername:port
""
nil
""
t
nil)
(list ; path/file
"Path/File: "
hm--html-info-path-alist
nil
nil
"/appl/lemacs/Global/info/dir")
(list ; anchor
"Node: "
'((""))
nil
nil
"emacs"
",")))
(defun hm--html-add-info-link ()
"Adds the HTML tags for a link on a GNU Info file."
(interactive)
(hm--html-add-info-link-1 'hm--html-add-tags))
(defun hm--html-add-info-link-to-region ()
"Adds the HTML tags for a link on a GNU Info file to the region."
(interactive)
(hm--html-add-info-link-1 'hm--html-add-tags-to-region))
(defun hm--html-add-wais-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a link to a WAIS server."
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
"http"
t
"http")
(list ; hostname:port
"Gateway and Port: "
hm--html-wais-hostname:port-alist
hm--html-wais-hostname:port-default
nil
"www.tnt.uni-hannover.de:8001")
(list ; servername:port
"Wais Servername and Port: "
hm--html-wais-servername:port-alist
hm--html-wais-servername:port-default
nil
"quake.think.com:210")
(list ; path/file
"Database: "
hm--html-wais-path-alist
nil
nil
"database")
(list ; anchor
"Searchstring: "
'((""))
nil
nil
"searchstring"
"?")))
(defun hm--html-add-wais-link ()
"Adds the HTML tags for a link to a WAIS server."
(interactive)
(hm--html-add-wais-link-1 'hm--html-add-tags))
(defun hm--html-add-wais-link-to-region ()
"Adds the HTML tags for a link to a WAIS server to the region."
(interactive)
(hm--html-add-wais-link-1 'hm--html-add-tags-to-region))
(defun hm--html-add-direct-wais-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a direct link to a WAIS server.
This function uses the new direct WAIS support instead of a WAIS gateway."
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
"wais"
t
"wais")
(list ; hostname:port
"Wais Servername and Port: "
hm--html-wais-servername:port-alist
hm--html-wais-servername:port-default
nil
"quake.think.com:210")
(list ; servername:port
""
nil
""
t
nil)
(list ; path/file
"Database: "
hm--html-wais-path-alist
nil
nil
"database")
(list ; anchor
"Searchstring: "
'((""))
nil
nil
"searchstring"
"?")))
(defun hm--html-add-direct-wais-link ()
"Adds the HTML tags for a direct link to a WAIS server.
This function uses the new direct WAIS support instead of a WAIS gateway."
(interactive)
(hm--html-add-direct-wais-link-1 'hm--html-add-tags))
(defun hm--html-add-direct-wais-link-to-region ()
"Adds the HTML tags for a direct link to a WAIS server to the region.
This function uses the new direct WAIS support instead of a WAIS gateway."
(interactive)
(hm--html-add-direct-wais-link-1 'hm--html-add-tags-to-region))
(defun hm--html-add-html-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a link to an HTML page."
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
"http"
t
"http")
(list ; hostname:port
"Servername and Port: "
hm--html-html-hostname:port-alist
hm--html-html-hostname:port-default
nil
"www.tnt.uni-hannover.de:80")
(list ; servername:port
""
nil
""
t
nil)
(list ; path/file
"Path/File: "
hm--html-html-path-alist
nil
nil
"/data/info/www/tnt/overview.html")
(list ; anchor
"Anchor: "
'((""))
nil
nil
"1"
"#")))
(defun hm--html-add-html-link ()
"Adds the HTML tags for a link to an HTML file."
(interactive)
(hm--html-add-html-link-1 'hm--html-add-tags))
(defun hm--html-add-html-link-to-region ()
"Adds the HTML tags for a link to an HTML file to the region."
(interactive)
(hm--html-add-html-link-1 'hm--html-add-tags-to-region))
(defun hm--html-add-file-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a filegateway link."
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
"file"
t
"file")
(list ; hostname:port
""
nil
""
t
nil)
(list ; servername:port
""
nil
""
t
nil)
(list ; path/file
"Path/File: "
hm--html-file-path-alist
nil
nil
"/data/info/www/tnt/overview.html")
(list ; anchor
"Anchor: "
'((""))
nil
nil
"1"
"#")))
(defun hm--html-add-file-link ()
"Adds the HTML tags for a for a filegateway link."
(interactive)
(hm--html-add-file-link-1 'hm--html-add-tags))
(defun hm--html-add-file-link-to-region ()
"Adds the HTML tags for a for a filegateway link to the region."
(interactive)
(hm--html-add-file-link-1 'hm--html-add-tags-to-region))
(defun hm--html-add-ftp-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a link to an FTP server."
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
"ftp"
t
"ftp")
(list ; hostname:port
"FTP Servername: "
hm--html-ftp-hostname:port-alist
hm--html-ftp-hostname:port-default
nil
"ftp.rrzn.uni-hannover.de")
(list ; servername:port
""
nil
""
t
nil)
(list ; path/file
"Path/File: "
hm--html-ftp-path-alist
nil
nil
"/pub/gnu/gcc-2.4.5.tar.gz")
(list ; anchor
""
nil
""
t
nil
nil)))
(defun hm--html-add-ftp-link ()
"Adds the HTML tags for a link to an FTP server."
(interactive)
(hm--html-add-ftp-link-1 'hm--html-add-tags))
(defun hm--html-add-ftp-link-to-region ()
"Adds the HTML tags for a link to an FTP server to the region."
(interactive)
(hm--html-add-ftp-link-1 'hm--html-add-tags-to-region))
(defun hm--html-add-gopher-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a link to a gopher server."
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
"gopher"
t
"gopher")
(list ; hostname:port
"Gopher Servername: "
hm--html-gopher-hostname:port-alist
hm--html-gopher-hostname:port-default
nil
"newsserver.rrzn.uni-hannover.de:70")
(list ; servername:port
"Documenttype: "
hm--html-gopher-doctype-alist
hm--html-gopher-doctype-default
nil
"/1")
nil ; path/file
(list ; anchor
"Entrypoint: "
hm--html-gopher-anchor-alist
nil
nil
"Subject%20Tree"
"/")))
(defun hm--html-add-gopher-link ()
"Adds the HTML tags for a link to a gopher server."
(interactive)
(hm--html-add-gopher-link-1 'hm--html-add-tags))
(defun hm--html-add-gopher-link-to-region ()
"Adds the HTML tags for a link to a gopher server to the region."
(interactive)
(hm--html-add-gopher-link-1 'hm--html-add-tags-to-region))
(defun hm--html-make-proggate-alist (proggate-allowed-file)
"Makes a proggate-alist from the PROGGATE-ALLOWED-FILE."
(if (and (stringp proggate-allowed-file)
(file-exists-p proggate-allowed-file))
(save-window-excursion
(let ((alist nil)
(buffername (find-file-noselect proggate-allowed-file)))
(set-buffer buffername)
(toggle-read-only)
(goto-char (point-min))
(while (search-forward-regexp "[^ \t\n]+" nil t)
(setq alist (append (list (list (buffer-substring
(match-beginning 0)
(match-end 0))))
alist)))
(kill-buffer buffername)
alist))
(error "ERROR: Can't find the 'hm--html-progate-allowed-file !")))
(defun hm--html-add-proggate-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a link to a program.
The program is called via the program gateway.
Email to muenkel@tnt.uni-hannover.de for information over
this gateway."
(let ((progname-alist (hm--html-make-proggate-alist
hm--html-proggate-allowed-file)))
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
"http"
t
"http")
(list ; hostname:port
"Servername and Port: "
hm--html-proggate-hostname:port-alist
hm--html-proggate-hostname:port-default
nil
"www.tnt.uni-hannover.de:8007")
(list ; program
"Programname: "
progname-alist
nil
nil
"/usr/ucb/man")
nil ; path/file
(list ; Program Parameter
"Programparameter: "
'((""))
nil
nil
"8+lpd"
"+"))))
(defun hm--html-add-proggate-link ()
"Adds the HTML tags for a link to a program.
The program is called via the program gateway.
Email to muenkel@tnt.uni-hannover.de for information over
this gateway."
(interactive)
(hm--html-add-proggate-link-1 'hm--html-add-tags))
(defun hm--html-add-proggate-link-to-region ()
"Adds the HTML tags for a link to a program to the region.
The program is called via the program gateway.
Email to muenkel@tnt.uni-hannover.de for information over
this gateway."
(interactive)
(hm--html-add-proggate-link-1 'hm--html-add-tags-to-region))
(defun hm--html-add-local-proggate-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a link to a program.
The program is called via the local program gateway.
Email to muenkel@tnt.uni-hannover.de for information over
this gateway."
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
""
t
nil)
(list ; hostname:port
""
nil
""
t
nil)
(list ; servername:port
""
nil
""
t
nil)
(list ; path/file
"Path/file: "
hm--html-local-proggate-path-alist
nil
nil
"/data/info/programs/lemacs.evlm")
(list ; anchor
""
nil
""
t
nil)))
(defun hm--html-add-local-proggate-link ()
"Adds the HTML tags for a link to a program.
The program is called via the local program gateway.
Email to muenkel@tnt.uni-hannover.de for information over
this gateway."
(interactive)
(hm--html-add-local-proggate-link-1 'hm--html-add-tags))
(defun hm--html-add-local-proggate-link-to-region ()
"Adds the HTML tags for a link to a program to the region.
The program is called via the local program gateway.
Email to muenkel@tnt.uni-hannover.de for information over
this gateway."
(interactive)
(hm--html-add-local-proggate-link-1 'hm--html-add-tags-to-region))
(defvar hm--html-newsgroup-alist nil
"Alist with newsgroups for the newsgateway.")
(defvar gnus-newsrc-assoc nil)
(defun hm--html-make-newsgroup-alist ()
"Makes a hm--html-make-newsgroup-alist from a .newsrc.el file.
The function looks at the environment variable NNTPSERVER.
If this variable exists, it trys to open the file with the Name
~/$NNTPSERVER.el. If this file exists, the alist of the file is
returned as the newsgroup-alist. If the file doesn't exist, it
tries to use the file ~/$NNTPSERVER to make the alist. The function
returns '((\"\"))"
(if hm--html-newsgroup-alist
hm--html-newsgroup-alist
(if gnus-newsrc-assoc
(setq hm--html-newsgroup-alist gnus-newsrc-assoc)
(if (not (getenv "NNTPSERVER"))
'((""))
(let ((newsrc-file (expand-file-name (concat "~/.newsrc-"
(getenv "NNTPSERVER")))))
(if (file-exists-p (concat newsrc-file ".el"))
(progn
(load-file (concat newsrc-file ".el"))
(setq hm--html-newsgroup-alist gnus-newsrc-assoc))
(if (not (file-exists-p newsrc-file))
'((""))
(save-window-excursion
(let ((alist nil)
(buffername (find-file-noselect newsrc-file)))
(set-buffer buffername)
(toggle-read-only)
(goto-char (point-min))
(while (search-forward-regexp "[^:!]+" nil t)
(setq alist (append (list (list (buffer-substring
(match-beginning 0)
(match-end 0))))
alist))
(search-forward-regexp "\n"))
(kill-buffer buffername)
(setq hm--html-newsgroup-alist alist))))))))))
(defun hm--html-add-news-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a link to a news group."
(let ((newsgroup-alist (hm--html-make-newsgroup-alist)))
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
"news"
t
"news")
(list ; hostname:port
""
nil
""
t
nil)
(list ; servername:port
"NEWS Group: "
newsgroup-alist
nil
nil
"alt.lucid-emacs.help")
nil ; path/file
(list ; anchor
""
nil
""
t
nil
nil))))
(defun hm--html-add-news-link ()
"Adds the HTML tags for a link to a news group."
(interactive)
(hm--html-add-news-link-1 'hm--html-add-tags))
(defun hm--html-add-news-link-to-region ()
"Adds the HTML tags for a link to a news group to the region."
(interactive)
(hm--html-add-news-link-1 'hm--html-add-tags-to-region))
(defun hm--html-add-mail-link-1 (function-add-tags)
"Internal function. Adds the HTML tags for a link to a mail box."
(hm--html-add-link function-add-tags
(list ; scheme
""
nil
"http"
t
"http")
(list ; hostname:port
"Hostname and Port: "
hm--html-mail-hostname:port-alist
hm--html-mail-hostname:port-default
nil
"www.tnt.uni-hannover.de:8003")
(list ; servername:port
""
nil
""
t
nil)
(list ; path/file
"Path/File: "
hm--html-mail-path-alist
nil
nil
"/data/info/mail/mailbox")
(list ; anchor
""
nil
""
t
nil
nil)))
(defun hm--html-add-mail-link ()
"Adds the HTML tags for a link to a mail box."
(interactive)
(hm--html-add-mail-link-1 'hm--html-add-tags))
(defun hm--html-add-mail-link-to-region ()
"Adds the HTML tags for a link to a mail box to the region."
(interactive)
(hm--html-add-mail-link-1 'hm--html-add-tags-to-region))
(defun hm--html-add-normal-link-to-region ()
"Adds the HTML tags for a normal general link to region."
(interactive)
(hm--html-add-tags-to-region 'hm--html-insert-start-tag
(concat "")
'hm--html-insert-end-tag
""))
(defun hm--html-add-normal-node-link ()
"Adds the HTML tags for a normal node link () at the point."
(interactive)
(hm--html-insert-start-tag (concat "")
))
;;; Functions to update the date and the changelog entries
(defun hm--html-maybe-new-date-and-changed-comment ()
"Hook function which updates the date in the title line, if
'hm--html-automatic-new-date' is t and which inserts a
\"changed comment\" line, if 'hm--html-automatic-changed-comment' is t."
(if hm--html-automatic-new-date
(hm--html-new-date))
(if hm--html-automatic-changed-comment
(hm--html-insert-changed-comment t)))
(defun hm--html-new-date ()
"The function sets the date in the title line up."
(interactive)
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t)
(end-of-head (if (search-forward "" nil t)
(point)
(if (search-forward "" nil t)
(point)
(point-max)))))
(goto-char (point-min))
(if (re-search-forward
(concat
"\\((\\)"
"\\([ \t]*[0-3]?[0-9]-[A-Z][a-z][a-z]-[0-9][0-9][0-9][0-9][ \t]*\\)"
"\\()[ \t\n]*\\)")
end-of-head
t)
(progn
(delete-region (match-beginning 2) (match-end 2))
(goto-char (match-beginning 2))
(insert (hm--date)))))))
(defun hm--html-insert-created-comment (&optional noerror)
"The function inserts a \"created comment\".
The comment looks like .
The comment will be inserted after the title line.
An error message is printed, if there is no title line and if
noerror is nil."
(interactive)
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t)
(end-of-head (if (search-forward "" nil t)
(point)
(if (search-forward "" nil t)
(point)
(point-max)))))
(goto-char (point-min))
(if (not (search-forward "" end-of-head t))
(if (not noerror)
(error "ERROR: Please insert a title in the document !"))
(let ((end-of-title-position (point)))
(if (search-forward ".
The comment will be inserted after the last \"changed comment\" line, or,
if there isn't such a line, after the \"created comment\" line, or,
after the title line. If there is no title and NOERROR is nil, an error
message is generated. The line is not inserted after the end of the head
or the beginning of the body.
If the last \"changed line\" is from the same author, it is only replaced
by the new one.
Attention: Don't change the format of the lines and don't write anything
else in such a line !"
(interactive)
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t)
(end-of-head (if (search-forward "" nil t)
(point)
(if (search-forward "" nil t)
(point)
(point-max))))
(username (or hm--html-username (user-full-name))))
(goto-char end-of-head)
(if (search-backward "